home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / com / computer / casio_st / prog_fx / divers / robot2.sha < prev    next >
Encoding:
Text File  |  1994-03-01  |  4.4 KB  |  145 lines
  1. 5 CLEAR:DIMTP$(1,4):DIMTx$(4,4),TX$(4,4),TI$(4,4),IND(4,4)
  2. 10 GOSUB 650:GOSUB 1000
  3. 32 GOSUB 360:A=NB
  4. 35 FORIX=A TO 1 STEP-1
  5. 37 GOSUB400
  6. 40 GOSUB100
  7. 45 GOSUB300
  8. 46 CLS:GOSUB700
  9. 47 CLS:GOSUB1050
  10. 50 NEXT IX
  11. 95 END
  12. 100 REM<K-1/K>
  13. 105 FORI=1 TO 4:FORJ=1 TO 4:Tx$(I,J)="0":NEXTJ:NEXTI:Tx$(4,4)=""
  14. 110 REM COEF
  15. 115 C1$="0":S1$="0":C4$="0":S4$="0"
  16. 120 I=COS(VAL(TP$(1,1)))
  17. 125 IF I=0 THEN 150 ELSE 130
  18. 130 IF I=1 THEN C1$="" ELSE C1$="-"
  19. 140 GOTO 170
  20. 150 I=SIN(VAL(TP$(1,1))
  21. 160 IF I=1 THEN S1$="" ELSE S1$="-"
  22. 170 IF TP$(1,4)<>"0" THEN 171 ELSE C4$="":GOTO 190
  23. 171 A$=LEFT$(TP$(1,4),1)
  24. 172 IF A$="G" THEN 173 ELSE 175
  25. 173 I=ASC(RIGHT$(STR$(IX),1)):C4$="c"+CHR$(I):S4$="s"+CHR$(I):GOTO 190
  26. 175 I=COS(VAL(TP$(1,4)))
  27. 176 IF I=0 THEN 178 ELSE 177
  28. 177 IF I=1 THEN C4$="" ELSE C4$="-":GOTO 190
  29. 178 I=SIN(VAL(TP$(1,4))
  30. 179 IF I=1 THEN S4$="" ELSE S4$="-"
  31. 190 REM
  32. 195 Tx$(1,1)=C4$
  33. 200 IF S4$="0" THEN 210 ELSE 205
  34. 205 IF S4$="-" THEN Tx(1,2)="":GOTO 210
  35. 206 IF S4$="" THEN Tx$(1,2)="-" ELSE Tx$(1,2)="-"+S4$
  36. 210 Tx$(1,4)=TP$(1,2)
  37. 220 IF C1$="0" THEN 225 ELSE 250
  38. 225 A$=S4$:B$=S1$:GOSUB 500:Tx$(3,1)=R$
  39. 230 A$=C4$:B$=S1$:GOSUB 500:Tx$(3,2)=R$
  40. 235 IF S1$="" THEN Tx$(2,3)="-" ELSE Tx$(2,3)=""
  41. 240 IF TP$(1,3)<>"0" THEN Tx$(2,4)=Tx$(2,3)+TP$(1,3)
  42. 245 GOTO 290
  43. 250 A$=S4$:B$=C1$:GOSUB 500:Tx$(2,1)=R$
  44. 260 A$=C4$:B$=C1$:GOSUB 500:Tx$(2,2)=R$
  45. 270 Tx$(3,3)=C1$
  46. 275 IF TP$(1,3)<>"0" THEN Tx$(3,4)=Tx$(3,3)+TP$(1,3)
  47. 290 RETURN
  48. 300 CLS:PRINT"<";IX-1;"/";IX;">"
  49. 304 FORI=1 TO 4
  50. 305 FORJ=1 TO 4
  51. 307 A$=Tx$(I,J):IF A$="" THEN A$="1"
  52. 308 IF A$="-" THEN A$="-1"
  53. 310 PRINT A$;";";
  54. 315 NEXTJ:PRINT""
  55. 320 NEXTI
  56. 350 REM MEMO
  57. 360 RESTORE#:RESTORE#"ROBOT":READ#A$
  58. 370 READ#NB
  59. 380 RETURN
  60. 400 GOSUB360
  61. 410 FORI=1 TO (IX-1)*4:READ#A$:NEXTI
  62. 420 FORI=1 TO 4:READ#TP$(1,I):NEXTI
  63. 430 RETURN
  64. 500 R$="0":REM PRINT"A=";A$;" B=";B$
  65. 510 IF A$="-" THEN 511 ELSE 520
  66. 511 IF B$="" THEN R$="-" ELSE R$=""
  67. 512 GOTO 600
  68. 520 IF A$="" THEN 521 ELSE 530
  69. 521 IF B$="" THEN R$="" ELSE R$="-"
  70. 522 GOTO 600
  71. 530 IF A$="0" THEN 600
  72. 540 R$=B$+A$
  73. 600 RETURN
  74. 650 REM OUTIL
  75. 660 RESTORE#"OUTIL":READ#A$
  76. 670 FORI=1 TO 4:FORJ=1 TO 4:READ#TX$(I,J):NEXTJ:NEXTI:RETURN
  77. 700 REM PROD MAT
  78. 710 FOR I=1 TO 4
  79. 715 FOR J=1 TO 4
  80. 717 LOCATE 0,0:PRINT"[";I;" ";J;"]";
  81. 720 R$="0"
  82. 725 FOR U=1 TO 4
  83. 730 A$=Tx$(I,U):B$=TX$(U,J)
  84. 735 P$="":GOSUB 800:IF P$="0" THEN 745 ELSE R$=R$+P$
  85. 745 NEXTU
  86. 746 IF (LEN(R$)>1) AND (LEFT$(R$,1)="0") THEN R$=RIGHT$(R$,LEN(R$)-1)
  87. 747 IF (LEFT$(R$,1)="+") THEN R$=RIGHT$(R$,LEN(R$)-1):GOTO 747
  88. 749 TI$(I,J)=R$
  89. 750 NEXTJ
  90. 755 NEXTI
  91. 760 RETURN
  92. 800 IL=1:IC=1:REM CONFIG
  93. 810 IF (A$="0") OR (B$="0") THEN P$="0":GOTO 860
  94. 815 IF A$="" THEN IL=1
  95. 820 IF A$="-" THEN IL=2
  96. 825 IF (LEN(A$)>1) OR (ASC(A$)>64) THEN 830 ELSE 840
  97. 830 IF LEFT$(A$,1)="-" THEN IL=4 ELSE IL=3
  98. 840 IF B$="" THEN IC=1
  99. 845 IF B$="-" THEN IC=2
  100. 850 IF (LEN(B$)>1) OR (ASC(B$>64) THEN 855 ELSE 856
  101. 855 IF LEFT$(B$,1)="-" THEN IC=4 ELSE IC=3
  102. 856 ON IND(IL,IC) GOSUB 900,910,920,930,940,950,960,970
  103. 860 RETURN
  104. 900 P$="+":RETURN
  105. 910 P$="-":RETURN
  106. 920 P$="+"+A$+B$:RETURN
  107. 930 P$=A$+B$:RETURN
  108. 940 RETURN
  109. 950 P$=A$:GOSUB 1200:RETURN
  110. 960 P$=B$:GOSUB 1200:RETURN
  111. 970 GOSUB 1400:RETURN
  112. 1000 DATA 1,2,3,4,2,1,7,7,3,6,8,8,4,6,8,8
  113. 1010 RESTORE 1000:FORI=1 TO 4:FORJ=1 TO 4:READIND(I,J):NEXTJ:NEXTI:RETURN
  114. 1050 REM TRANSF TX<-TI
  115. 1055 PRINT"<";IX-1;"/E>"
  116. 1060 FORI=1 TO 3
  117. 1070 FORJ=1 TO 4
  118. 1080 TX$(I,J)=TI$(I,J):PRINT TX$(I,J);";";:TI$(I,J)="0"
  119. 1090 NEXTJ:PRINT""
  120. 1100 NEXTI
  121. 1110 RETURN
  122. 1200 K=0:REM INVP
  123. 1210 K=K+1
  124. 1220 L$=MID$(P$,K,1):IF (K=1) AND (ASC(L$)>46) THEN P$="-"+P$
  125. 1230 IF L$="+" THEN P$=LEFT$(P$,K-1)+"-"+RIGHT$(P$,LEN(P$)-K) ELSE IF L$="-" THEN P$=LEFT$(P$,K-1)+"+"+RIGHT$(P$,LEN(P$)-K)
  126. 1240 IF K>=LEN(P$) THEN RETURN ELSE GOTO 1210
  127. 1300 REM PROD
  128. 1315 K=1:P$="":S$=MID$(G$,IY,1)
  129. 1317 IF (IY+K)>LEN(G$) THEN 1320
  130. 1318 L$=MID$(G$,IY+K,1):IF (L$="+") OR (L$="-") THEN GOTO 1320 ELSE K=K+1:GOTO 1317
  131. 1320 P$=MID$(G$,IY+1,K-1):IY=IY+K:RETURN
  132. 1400 IF ASC(MID$(A$,1,1)<46 THEN 1405 ELSE A$="+"+A$
  133. 1405 IF ASC(MID$(B$,1,1)<46 THEN 1410 ELSE B$="+"+B$
  134. 1410 PT$="":NA=0:NB=0
  135. 1412 FORK=1 TO LEN(A$):IF ASC(MID$(A$,K,1))<46 THEN NA=NA+1
  136. 1413 NEXT
  137. 1414 FORK=1 TO LEN(B$):IF ASC(MID$(B$,K,1))<46 THEN NB=NB+1
  138. 1415 NEXT:IA=1:IB=1
  139. 1417 FORN=1 TO NA
  140. 1420 G$=A$:IY=IA:GOSUB 1300:IA=IY:PA$=P$:SA$=S$
  141. 1422 FORM=1 TO NB
  142. 1425 G$=B$:IY=IB:GOSUB 1300:IB=IY:PB$=P$:SB$=S$
  143. 1430 IF SA$=SB$ THEN P$="+"+PA$+PB$ ELSE P$="-"+PA$+PB$
  144. 1431 PT$=PT$+P$:NEXT:IB=1:NEXT:P$=PT$:RETURN
  145.